perm filename MOVER.OLD[XX,LCS]1 blob sn#217902 filedate 1976-05-30 generic text, type T, neo UTF8
00100	C******  MOVER, MVBEAM, MVBX, RTLINE, EXTEN, CLEFS
00200		SUBROUTINE MOVER
00300		IMPLICIT INTEGER(A-Q,S-Z)
00400		DIMENSION R(2,200),IR(2,200),NP(500)
00500		REAL POS,EXTEN,PRCNT,ACCX
00600		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/STF/RSTFAC(-3/4),RSTJ2
00700		COMMON/XRN/RN(4000)  /KJY/ KY,JY
00800		COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
00900		COMMON/POSI/STFF(-3/4),JJ2,POS/PTR/PWDS(250),ITEM,LL,I,IX
01000		COMMON/ALF/INP(46),ACCX,ML,RRT,RZRO,RCNT,RJSZ,ROV,RSPC,KN,RA,RB,
01100		1 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,RV,RQ6
01200	      EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
01300		1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(R11,RJQ(9))
01400		1,(IR,R,RN(3501)),(NP,RN(3000))
01500		DATA F78F/'(78F)'/,FA1/'(A1 )'/,FA5/'(A5 )'/,RSP/.5/,RI/4.5/
01600	
01700		JJ2=999
01800		J2=0
01900		ASK=-1
02000	C  99=BACKUP
02100	6	CALL VLINE(R2,R4,R5,R6)
02200		IF(R2.GE.99)RETURN
02300		IF(INP(1).EQ.'J')GO TO 12
02400	167	TYPE 5
02500		ACCEPT F78F,R7,R8,R9,R11
02510		IF(R2.LE.4.AND.R7.GT.4)GO TO 167
02520	C  TRY AGAIN IF CONFUSION.
02600		RDIS=0
02700		REREAD FA1,L
02800	C FOR LPEN TYPE 'L'. BUT 4TH # MUST APPEAR WHEN NEEDED.
02900		IF(L.EQ.'B')GO TO 6
03000		IF(R7.GE.99)GO TO 6
03100		IF(R2.GT.4)R7=R2
03200		IF(R7.NE.R2)TYPE 1200,R7
03300	1201	IF(L.NE.'L')GO TO 66
03400		DO 67 K=1,2
03500		R8=RY
03600		CALL LPEN(R7,RY,RX)
03700	67	IF(R7.GE.99)GO TO 6
03800		R9=RY
03900	CC66	JJ2=1
04000	66	NST=1
04100	C  FOR START OF LOOP (1 UNLESS USING COPYIT)
04200		IF(INP(1).NE.'C')GO TO 68
04300		NST=ITEM+1
04400		CALL COPYIT
04500	68	IF(R11.NE.0)CALL UPDN(NST)
04600		JJ=0 
04700		IF(R4.NE.R8.OR.R5.NE.R9)JJ=-1
04800		JY=0
04900	C  JY IS CHANGED IN GETPTS
05000		IF(JJ)CALL GETPTS(NST)
05010		IF(R2.NE.R7)CALL STFCH
05050		IF(JY.NE.0)GO TO 1
05060	7	IF(JJ2.EQ.999)JJ2=-1
05070		RETURN
05200	CC	IF(JY.EQ.0)RETURN
05300	1	CALL MOVIT
05400		RETURN
05500	12	IF(R4.EQ.0)R4=.001
05600		IF(R5.EQ.0)R5=200
05700		RCNT=0
05800		RRT=R5
05900		RZRO=R4
06000		RJSZ=RI
06100		CALL GETPTS(1)
06200		IF(JY.EQ.0)GO TO 7
06250	C RETURN IF NO ITEMS FOUND TO DEAL WITH.
06300		ROV=RRT
06400		PRCNT=1.
06500		R7=R2
06600		R6=0
06700		R11=0
06800	19	IF(RCNT.GT.9)GO TO 101
06900		RJSZ=RJSZ-.06
07000		RP=PRCNT
07100		RCNT=RCNT+1
07200	C  TEMPORARY COUNTER
07300		TYPE F78F,RCNT
07400	
07500		DO 11 KN=-3,4
07600		RSPC=0
07700		R8=KN
07800		N=0
07900	
08000		DO 2 K=1,KY
08100		L=NP(K)
08200		RL=RN(L)
08300		RA=RN(L+1)
08400		RB=RN(L+3)
08500		IF(RN(L+2).EQ.R8)GO TO 77
08600	C  THIS STAFF?
08700		IF(RA.NE.4)GO TO 2
08800	C  SKIPS HOMED NOTES (IN CHORDS)
08900	CC77	IF(RA.EQ.1)GO TO 10
09000	CC27	IF(RA.LE.4)GO TO 177
09100	77	IF(RA.LT.3)GO TO 10
09200		IF(RA.EQ.4)GO TO 444
09300		IF(RA.EQ.3)GO TO 333
09400	C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
09500		IF(RA.LT.17)GO TO 2
09600		GO TO 10
09700	333	IF(RL.LT.3)GO TO 10
09800	C  <3 MEANS NOTHING IN P5
09900		IF(AMOD(RN(L+5),100.0).GT.3)GO TO 2
10000	C  NOT A REAL CLEF IF >3
10100		GO TO 10
10200	444	IF(RL.GT.2)GO TO 2
10300	C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
10400	10	N=N+1
10500		R(1,N)=RB
10600		IR(2,N)=L
10700		IF(N.EQ.200)GO TO 28
10800	C  ONLY TREATS 200 ITEMS AT A TIME.
10900	2	CONTINUE
11000	
11100		IF(N.EQ.0)GO TO 11
11200	28	DO 23 K=1,N
11300	23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
11400	C  SKIPS IF ONLY BAR LINES ON THIS STAFF
11500		GO TO 11
11600	24	RSTJ2=RSTFAC(KN)*PRCNT
11700		CALL SORT2(R,N)
11800	
11900	C  JUMP IF LAST IS A BAR LINE.
12000		K=0
12100		JLDGR=0
12200	     	JX=0
12300	22	K=K+1
12400	122	L=IR(2,K)
12500		RA=RN(L+1)
12550	C  RA IS NOW CODE NUM.
12600		RB=0
12610		RD=0
12655	C  RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
12700		RX=RN(L+5)
12800	C  RX=PARAM 5
12900		RX6=RN(L+6)
13000		RY=1
13100		RW=AMOD(RN(L+4),100.)
13200		IF(RA.GT.1)GO TO 4
13300		RZ=RN(L+7)
13400		IF(LDGR.NE.JLDGR)JLDGR=0
13500		LDGR=0
13600		JK=K
13700		DO 32 JJ=JK+1,N+1
13800		K=JJ
13810		RB=R(1,JJ)-R(1,JJ-1)
13820		IF(RB.GT.0.1)GO TO 320
13825	C  PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
13830		R(1,JJ)=R(1,JJ-1)
13840		GO TO 32
13900	320	IF(RB.GT.RSP)GO TO 35
13910	32	CONTINUE
14000	C  FOUND HOW MANY MEMBERS TO CHORD.
14100	35	RB=0
14200		K=K-1
14300		RQ=0
14500	CC125	IF(AMOD(RN(L+4),200.).GT.60.)RY=.6
14510	125	RC=ABS(RN(L+4))
14515		
14520		IF(RC.LT.60)GO TO 137
14530		IF(RC.LT.180)RY=.6
14540	C  FOUND A MINI-NOTE
14600	137	DO 37 JJ=JK,K-1
14700		IF(RD.NE.0)GO TO 38
14800	C FINDS ONLY HIGH OR! LOW LED. LINE.
14900		JR=IR(2,JJ)
15000		RW=AMOD(RN(JR+4),100.)
15100		IF(RW.GT.12)GO TO 277
15200		IF(RW.GE.2)GO TO 38
15300	277	LDGR=-1
15400		IF(RW.GT.11)LDGR=1
15500		IF(JLDGR.EQ.LDGR)GO TO 36
15600		JLDGR=LDGR
15700	C LDGR IS FOR LEDGER LINES.
15800		GO TO 38
15900	36	RD=1.5
16000		RQ=RD
16100	38	IF(RB.GT.2)GO TO 222
16200	C  JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
16300		RZZ=RN(JR+7)
16400		RE=RN(JR+5)
16500	CC	IF(RB.LT.2.AND.((AMOD(RZZ,10.).NE.0.AND.RE.LT.20).
16600	CC	1 OR.RZZ.GE.10))RB=1.5+EXTEN(RZZ)
16700		IF(RB.GE.2)GO TO 477
16800		IF(RZZ.GE.10)GO TO 377
16900		IF(RE.GE.20)GO TO 477
17000		IF(AMOD(RZZ,10.).EQ.0)GO TO 477
17100	377	RB=1.5+EXTEN(RZZ)
17200	C  SPACE FOR DOT OR TAIL(IF STEM UP)
17300	477	IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
17400	C  FOR CHORD TONES ON RIGHT OF STEM UP.
17500	C  LOOKS THROUGH ALL NOTES OF A CHORD.
17600	222	IF(AMOD(RE,10.).EQ.0)GO TO 37 
17700	C  JUMP IF NO ACCIS.
17800	425	RD=2*RY+EXTEN(RE)
17900		IF(RQ.GT.RD)RD=RQ
18000		RQ=RD
18100	C  FUNCT. EXTEN=AMOD(X,1.)*10.
18200	37 	CONTINUE
18300		IF(RY.NE.1)RB=RB-.5*RJSZ
18400	C  MINI NOTES NEED LESS SPACE
18500	250	ACCX=0
18600		RC=0
18700		RW=R(1,JX+1)
18800		DO 132 JJ=JX+1,N  
18900		IF(RW.NE.R(1,JJ))GO TO 25
19000		KX=IR(2,JJ)
19100	C  GET POINTER
19200		IF(RN(KX+1).NE.1)GO TO 25
19300	C  ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
19310		RE=ABS(RN(KX+6))
19330		IF(RE.GE.10)RC=-2.6
19340		IF(RE.EQ.20)RC=-RC
19350	CC 2/25/76	IF(ABS(RN(KX+6)).GE.20)RC=2.6
19400		RE=AMOD(RN(KX+5),10.0)
19500	C  FIND AN ACCI
19600		IF(RE.EQ.0)GO TO 132
19700		IF(RE.GE.1)RC=RC+2
19800	C  FOUND AN ACCI
19900	CC	***** WHY WAS THIS *10?????    RC=AMOD(RE,1.0)*10.0+RC
19910		RC=AMOD(RE,1.0)*10.0+RC
20000	C  ADD ANY EXTENSION TO THE LEFT
20100		IF(RC.GT.ACCX)ACCX=RC
20200		RC=0
20250		IF(ACCX.GT.RD)RD=ACCX
20300	132	CONTINUE
20400	25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
20500		GO TO 17
20510	4	IF(RA.NE.2)GO TO 33
20530	C  NEXT FOR DOTTED RESTS - IN P6
20540		IF(RN(L).GE.4)RB=RN(L+6)*1.5
20545	C  NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
20550		GO TO 250
20600	33	IF(RA.NE.3)GO TO 29
20700		RB=3
20800		IF(RX.GT.100)RB=1.5
20900	C  CHECK ON SIZE NEEDED FOR CLEFS
21000	29	IF(RA.NE.4)GO TO 26
21100		RB=-RJSZ/2
21200		RD=.9
21300		GO TO 25
21400	26	IF(RA.NE.18)GO TO 30
21500		IF(RX6.GT.9)GO TO 31
21600		IF(RX.GT.9)GO TO 31
21700	C  CHECKS FOR 2-DIGIT METERS
21800		RB=-1
21900		RD=1
22000		GO TO 25
22100	31	RB=2
22200		RD=3
22300		GO TO 25
22400	30	IF(RA.NE.17)GO TO 17
22500		RB=2*(ABS(RX)-1)-2
22600	C  SPACES FOR CORRECT NUM OF ACCIS.  RX=NUM OF ACCIS.
22700		RD=2
22800		GO TO 25
22820	C  ↑↑↑↑↑ TO RESET AFTER CHORD NOTES 12/75
22900	17	RC=(RB+RJSZ)*RSTJ2
23000	C  RJSZ=DEFAULT SIZE
23100		JX=K
23200		R(2,JX)=RC
23300	CC???????	R(1,JX)=R(1,K)
23400	3	IF(K.LT.N)GO TO 22
23500		RA=R(1,1)
23600		RB=R(2,1)
23700	
23800		DO 13 KX=2,JX
23900		RE=R(1,KX)
24000	C  POS. BEFORE SHIFTING
24100		IF(ABS(RE-RA).GT..5)GO TO 14
24200		IF(R(2,KX).GT.RB)GO TO 16
24300	C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
24400		GO TO 13
24500	C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
24600	14	RD=RA+RB-RE
24700		IF(RD.LE.0)GO TO 16
24800	C  THERE'S ENOUGH ROOM
24900		ROV=ROV+RD
25000	140	R4=RE+RSPC-.001
25100		R5=10000
25200		R8=RD
25300		R9=0
25400	C  GO EXPAND IT
25500		IF(R(2,KX).EQ.0)GO TO 15
25600		CALL MOVIT
25700		IF(R2.LE.4)GO TO 15
25800		R5=R4
25900		R4=RA+.001+RSPC
26000		R8=R4
26100		R9=R5+RD-.001
26200	C  FOR ITEMS ON OTHER LINES.
26300		CALL MOVIT
26400	15	RSPC=RSPC+RD
26500	C  RSPC SAVES TOTAL SPACE ADDED
26600	16	RB=R(2,KX)
26700	13	RA=RE
26800	11	CONTINUE
26900	110	IF(ROV.LE.RRT+.01)RETURN
27000		IF(RJSZ.GT.4)RJSZ=4
27100		PRCNT=(ROV-RZRO)/(RRT-RZRO)
27200		IF(PRCNT.NE.RP)GO TO 19
27300	C  GO BACK AND EXPAND SOME MORE
27400	101	R4=RZRO
27500		R5=ROV
27600		R8=RZRO
27700		R9=RRT-.001
27800	C  JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
27900		CALL MOVIT
28000	C  RVX SHOULD BE FARTHEST POINT TO RIGHT.
28100	1200	FORMAT(' MOVED TO STAFF ',F4.0/)
28200		CALL HYDPOG(3)
28300	5	FORMAT(' TYPE NEW STAFF #, POS1, POS2, UP-DOWN #  '$)
28400		END